tau optimization
Lluís Revilla Sancho
Wed Jul 18 16:20:49 2018
Introduction
Prepare the data
# Load data ####
data(ge_cgh_locIGR, package = "gliomaData")
A <- ge_cgh_locIGR$multiblocks
Loc <- factor(ge_cgh_locIGR$y)
levels(Loc) <- colnames(ge_cgh_locIGR$multiblocks$y)
ncomp <- rep(1, length(A))
# rgcca algorithm using the dual formulation for X1 and X2
# and the dual formulation for X3
A[[3]] = A[[3]][, -3]
C <- matrix(c(0, 0, 1, 0, 0, 1, 1, 1, 0), 3, 3)
dimnames(C) <- list(names(A), names(A))
C
## GE CGH y
## GE 0 0 1
## CGH 0 0 1
## y 1 1 0Preparing the taus
Testing the tau effect on the AVE
(min_shrinkage <- sapply(A, function(x) {
1 / sqrt(ncol(x))
}))
## GE CGH y
## 0.007980361 0.028524895 0.707106781
taus <- lapply(min_shrinkage, seq, to = 1, length.out = 10)
taus.combn <- expand.grid(taus)
keep <- apply(taus.combn, 1, function(x){sum(x != 0)})
taus.combn <- taus.combn[keep >= 2, ]
# Add the example values at the bottom
taus.combn <- rbind(taus.combn, c(.071,.2, 1))
head(taus.combn)
## GE CGH y
## 1 0.007980361 0.0285249 0.7071068
## 2 0.118204765 0.0285249 0.7071068
## 3 0.228429169 0.0285249 0.7071068
## 4 0.338653574 0.0285249 0.7071068
## 5 0.448877978 0.0285249 0.7071068
## 6 0.559102382 0.0285249 0.7071068Calculate the AVE values
We iterate over the list of taus
out <- sapply(seq_len(nrow(taus.combn)), function(x){
result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp,
scheme = "centroid", verbose = FALSE)
unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
centroid <- cbind.data.frame(t(out), taus.combn)
saveRDS(centroid, "centroid_tau.RDS")out <- sapply(seq_len(nrow(taus.combn)), function(x){
result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp,
scheme = "factorial", verbose = FALSE)
unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
factorial <- cbind.data.frame(t(out), taus.combn)
saveRDS(factorial, "factorial_tau.RDS")out <- sapply(seq_len(nrow(taus.combn)), function(x){
result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp,
scheme = "horst", verbose = FALSE)
unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
horst <- cbind.data.frame(t(out), taus.combn)
saveRDS(horst, "horst_tau.RDS")
library("dplyr")
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
horst %>%
# group_by(GE, CGH, y) %>% add_count() %>%
filter(AVE_inner == max(AVE_inner))
## AVE_inner AVE_outer GE CGH y
## 1 0.6430402 0.07189818 0.1182048 0.4602916 1Plot the result
p <- ggplot(centroid)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
geom_smooth(aes(GE, AVE_inner, col = "inner")) +
geom_smooth(aes(GE, AVE_outer, col = "outer")) +
geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(y, AVE_inner, col = "inner")) +
geom_smooth(aes(y, AVE_outer, col = "outer")) +
geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type')
q <- p + geom_count(aes(AVE_outer, AVE_inner)) +
xlab("AVE outer") + ylab("AVE inner")
(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
p <- ggplot(factorial)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
geom_smooth(aes(GE, AVE_inner, col = "inner")) +
geom_smooth(aes(GE, AVE_outer, col = "outer")) +
geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(y, AVE_inner, col = "inner")) +
geom_smooth(aes(y, AVE_outer, col = "outer")) +
geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type')
q <- p + geom_count(aes(AVE_outer, AVE_inner)) +
xlab("AVE outer") + ylab("AVE inner")
(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
p <- ggplot(horst)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
geom_smooth(aes(GE, AVE_inner, col = "inner")) +
geom_smooth(aes(GE, AVE_outer, col = "outer")) +
geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
geom_smooth(aes(y, AVE_inner, col = "inner")) +
geom_smooth(aes(y, AVE_outer, col = "outer")) +
geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type')
q <- p + geom_count(aes(AVE_outer, AVE_inner)) +
xlab("AVE outer") + ylab("AVE inner")
(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
Session Info
## Session info -------------------------------------------------------------
## setting value
## version R version 3.5.0 (2018-04-23)
## system i686, linux-gnu
## ui X11
## language en_US
## collate en_US.UTF-8
## tz Europe/Madrid
## date 2018-07-18
## Packages -----------------------------------------------------------------
## package * version date source
## assertthat 0.2.0 2017-04-11 CRAN (R 3.5.0)
## backports 1.1.2 2017-12-13 CRAN (R 3.5.0)
## base * 3.5.0 2018-04-23 local
## bindr 0.1.1 2018-03-13 CRAN (R 3.5.0)
## bindrcpp * 0.2.2 2018-03-29 CRAN (R 3.5.0)
## codetools 0.2-15 2016-10-05 CRAN (R 3.5.0)
## colorspace 1.3-2 2016-12-14 CRAN (R 3.5.0)
## compiler 3.5.0 2018-04-23 local
## crayon 1.3.4 2017-09-16 CRAN (R 3.5.0)
## datasets * 3.5.0 2018-04-23 local
## devtools 1.13.5 2018-02-18 CRAN (R 3.5.0)
## digest 0.6.15 2018-01-28 CRAN (R 3.5.0)
## dplyr * 0.7.6 2018-06-29 CRAN (R 3.5.0)
## evaluate 0.10.1 2017-06-24 CRAN (R 3.5.0)
## ggplot2 * 3.0.0 2018-07-03 CRAN (R 3.5.0)
## gliomaData * 0.4 2018-07-04 Github (llrs/gliomaData@2b1004c)
## glue 1.2.0 2017-10-29 CRAN (R 3.5.0)
## graphics * 3.5.0 2018-04-23 local
## grDevices * 3.5.0 2018-04-23 local
## grid 3.5.0 2018-04-23 local
## gtable 0.2.0 2016-02-26 CRAN (R 3.5.0)
## htmltools 0.3.6 2017-04-28 CRAN (R 3.5.0)
## knitr 1.20 2018-02-20 CRAN (R 3.5.0)
## labeling 0.3 2014-08-23 CRAN (R 3.5.0)
## lattice 0.20-35 2017-03-25 CRAN (R 3.5.0)
## lazyeval 0.2.1 2017-10-29 CRAN (R 3.5.0)
## magrittr 1.5 2014-11-22 CRAN (R 3.5.0)
## MASS 7.3-50 2018-04-30 CRAN (R 3.5.0)
## Matrix 1.2-14 2018-04-09 CRAN (R 3.5.0)
## memoise 1.1.0 2017-04-21 CRAN (R 3.5.0)
## methods * 3.5.0 2018-04-23 local
## mgcv 1.8-24 2018-06-18 CRAN (R 3.5.0)
## munsell 0.5.0 2018-06-12 CRAN (R 3.5.0)
## nlme 3.1-137 2018-04-07 CRAN (R 3.5.0)
## patchwork * 0.0.1 2018-06-22 Github (thomasp85/patchwork@1d3eccb)
## pillar 1.3.0 2018-07-14 CRAN (R 3.5.0)
## pkgconfig 2.0.1 2017-03-21 CRAN (R 3.5.0)
## plyr 1.8.4 2016-06-08 CRAN (R 3.5.0)
## purrr 0.2.5 2018-05-29 CRAN (R 3.5.0)
## R6 2.2.2 2017-06-17 CRAN (R 3.5.0)
## Rcpp 0.12.17 2018-05-18 CRAN (R 3.5.0)
## RGCCA * 2.1.2 2017-05-11 CRAN (R 3.5.0)
## rlang 0.2.1 2018-05-30 CRAN (R 3.5.0)
## rmarkdown 1.10 2018-06-11 CRAN (R 3.5.0)
## rprojroot 1.3-2 2018-01-03 CRAN (R 3.5.0)
## rstudioapi 0.7 2017-09-07 CRAN (R 3.5.0)
## scales 0.5.0 2017-08-24 CRAN (R 3.5.0)
## stats * 3.5.0 2018-04-23 local
## stringi 1.2.3 2018-06-12 CRAN (R 3.5.0)
## stringr 1.3.1 2018-05-10 CRAN (R 3.5.0)
## tibble 1.4.2 2018-01-22 CRAN (R 3.5.0)
## tidyselect 0.2.4 2018-02-26 CRAN (R 3.5.0)
## tools 3.5.0 2018-04-23 local
## utils * 3.5.0 2018-04-23 local
## withr 2.1.2 2018-03-15 CRAN (R 3.5.0)
## yaml 2.1.19 2018-05-01 CRAN (R 3.5.0)